Unit mnWinCommStreams;
{**
 *  This file is part of the "Mini Comm"
 *
 * @license   modifiedLGPL (modified of http://www.gnu.org/licenses/lgpl.html)
 *            See the file COPYING.MLGPL, included in this distribution,
 * @author    Zaher Dirkey <zaher at parmaja dot com>
 * Some function ported from ComPort at sourceforge thanks for them
 *}

  {$M+}
  {$H+}
  {$IFDEF FPC}
  {$mode delphi}
  {$ENDIF}

Interface

Uses
    Windows,
    Classes, SysUtils,
    mnStreams, mnCommClasses;

Type
    TmnOSCommStream = Class(TmnCustomCommStream)
    private
        FHandle: THandle;
        FCancelEvent: THandle;
    protected
        Procedure DoConnect; override;
        Procedure DoDisconnect; override;
        Function GetConnected: Boolean; override;
        Function DoWrite(Const Buffer; Count: Integer): Integer; override;
        Function DoRead(Var Buffer; Count: Integer): Integer; override;
    public
        Function WaitEvent(Const Events: TComEvents): TComEvents; override;
        Function GetInQue: Integer; override;
        Procedure Flush; override;
        Procedure Purge; override;
        Procedure Reset; override;
        Procedure Cancel; override;
    End;

Implementation

Uses
    mnWinCommTypes;

Procedure TmnOSCommStream.Cancel;
Begin
    Inherited;
    If FCancelEvent <> 0 Then
    Begin
        SetEvent(FCancelEvent);
        Sleep(0);
    End;
End;

Procedure TmnOSCommStream.DoConnect;
Var
    f: THandle;
    DCB: TDCB;
    aTimeouts: TCommTimeouts;
    P: Pointer;
    aMode: Cardinal;
Begin
    If UseOverlapped Then FCancelEvent := CreateEvent(Nil, True, False, Nil);

    {$ifdef WINCE}
    P := PWideChar(UTF8Decode(Port + ':'));
    {$else}
    P := PChar('\\.\' + Port);
    {$endif}
  
    aMode := 0;
    Case ConnectMode Of
        ccmReadWrite: 
            aMode := GENERIC_READ or GENERIC_WRITE;
        ccmRead: 
            aMode := GENERIC_READ;
        ccmWrite: 
            aMode := GENERIC_WRITE;
    End;
  
    f := CreateFile(P, aMode, 0, Nil, OPEN_EXISTING,
        cWriteThrough[WriteThrough] or cOverlapped[UseOverlapped], 0);

    If (f = INVALID_HANDLE_VALUE) Then
    Begin
        RaiseLastOSError;
    End;

    FHandle := f;
    Try
        If not SetupComm(FHandle, BufferSize, BufferSize) Then RaiseLastOSError;

        DCB.DCBlength := SizeOf(TDCB);
        DCB.XonLim    := BufferSize div 4;
        DCB.XoffLim   := DCB.XonLim;
        DCB.EvtChar   := EventChar;

        DCB.Flags := dcb_Binary;
        If DiscardNull Then DCB.Flags := DCB.Flags or dcb_Null;

        With GetFlowControlFlags Do
        Begin
            DCB.XonChar := XonChar;
            DCB.XoffChar := XoffChar;
            If OutCTSFlow Then DCB.Flags := DCB.Flags or dcb_OutxCTSFlow;
            If OutDSRFlow Then DCB.Flags := DCB.Flags or dcb_OutxDSRFlow;
            DCB.Flags := DCB.Flags or CControlDTR[ControlDTR] or
                CControlRTS[ControlRTS];
            If XonXoffOut Then DCB.Flags := DCB.Flags or dcb_OutX;
            If XonXoffIn Then DCB.Flags := DCB.Flags or dcb_InX;
            If DSRSensitivity Then DCB.Flags := DCB.Flags or dcb_DSRSensivity;
            If TxContinueOnXoff Then DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff;
        End;

        DCB.Parity   := CParityBits[Parity];
        DCB.StopBits := CStopBits[StopBits];
        DCB.BaudRate := BaudRate;
        DCB.ByteSize := cDataBits[DataBits];

        With GetParityFlags Do If Check Then
            Begin
                DCB.Flags := DCB.Flags or dcb_Parity;
                If Replace Then
                Begin
                    DCB.Flags := DCB.Flags or dcb_ErrorChar;
                    DCB.ErrorChar := AnsiChar(ReplaceChar);
                End;
            End;

        // apply settings
        If not SetCommState(FHandle, DCB) Then RaiseLastOSError;

        aTimeouts.ReadIntervalTimeout         := MAXWORD;
        aTimeouts.ReadTotalTimeoutMultiplier  := ReadTimeout;
        aTimeouts.ReadTotalTimeoutConstant    := ReadTimeoutConst;
        aTimeouts.WriteTotalTimeoutMultiplier := WriteTimeout;
        aTimeouts.WriteTotalTimeoutConstant   := WriteTimeoutConst;

        If not SetCommTimeouts(FHandle, aTimeouts) Then RaiseLastOSError;

    Except
        If FHandle <> 0 Then CloseHandle(FHandle);
        FHandle := 0;
        Raise;
    End;
End;

Procedure TmnOSCommStream.DoDisconnect;
Begin
    If FHandle <> 0 Then 
    Try
        FileClose(FHandle);
    Finally
        FHandle := 0;
    End;
    If FCancelEvent <> 0 Then
    Begin
        CloseHandle(FCancelEvent);
        FCancelEvent := 0;
    End;
End;

Procedure TmnOSCommStream.Flush;
Begin
    Inherited;
    If not Flushfilebuffers(FHandle) Then RaiseLastOSError;
End;

Function TmnOSCommStream.GetConnected: Boolean;
Begin
    Result := FHandle <> 0;
End;

Function TmnOSCommStream.GetInQue: Integer;
Var
    Errors: DWORD;
    ComStat: TComStat;
Begin
    If Connected Then
    Begin
        If not ClearCommError(FHandle, Errors, @ComStat) Then
        Raise EComPort.Create('Clear Com Failed');
        Result := ComStat.cbInQue;
    End
    Else Result := 0;
End;

Procedure TmnOSCommStream.Purge;
Var
    F: Integer;
Begin
    Inherited;
    F := PURGE_TXCLEAR or PURGE_TXABORT or PURGE_RXABORT or PURGE_RXCLEAR;
    If not PurgeComm(FHandle, F) Then RaiseLastOSError;
End;


Procedure TmnOSCommStream.Reset;
Begin
    Inherited;
End;

Function TmnOSCommStream.WaitEvent(Const Events: TComEvents): TComEvents;
Var
    Overlapped: TOverlapped;
    EventHandles: Array[0..1] Of THandle;
    Mask: DWord;
    Count: Integer;
    E: Boolean;
    R: Integer;
Begin
    Result := [];
    FillChar(Overlapped, SizeOf(TOverlapped), 0);
    Overlapped.hEvent := CreateEvent(Nil, True, False, Nil);
    EventHandles[0] := Overlapped.hEvent;
    If FCancelEvent <> 0 Then
    Begin
        EventHandles[1] := FCancelEvent;
        Count           := 2;
    End
    Else Count := 1;

    Try
        Mask := EventsToInt(Events);
        SetCommMask(FHandle, Mask);
        E := WaitCommEvent(FHandle, Mask, @Overlapped);
        If (E) or (GetLastError = ERROR_IO_PENDING) Then
        Begin
            R := WaitForMultipleObjects(Count, @EventHandles, False, Timeout);
            If (R = WAIT_OBJECT_0) Then
            Begin
                GetOverlappedResult(FHandle, Overlapped, Mask, False);
                Result := IntToEvents(Mask);
            End;
            E := (R = WAIT_OBJECT_0) or (R = WAIT_OBJECT_0 + 1) or (R = WAIT_TIMEOUT);
            SetCommMask(FHandle, 0);
        End;

        If not E Then
        Begin
            Raise EComPort.Create('Wait Failed');
        End;
    Finally
        CloseHandle(Overlapped.hEvent);
    End;
End;

Function TmnOSCommStream.DoRead(Var Buffer; Count: Integer): Integer;
Var
    Bytes: DWORD;
    Overlapped: TOverlapped;
    EventHandles: Array[0..1] Of THandle;
    P: POverlapped;
    E: Cardinal;
    R: Integer;
Begin
    Bytes := 0;
    Result := 0;
    P := Nil;
    Try
        If UseOverlapped Then
        Begin
            FillChar(Overlapped, SizeOf(Overlapped), 0);
            Overlapped.hEvent := CreateEvent(Nil, True, True, Nil);
            EventHandles[0] := Overlapped.hEvent;
            EventHandles[1] := FCancelEvent;
            P := @Overlapped;   
        End
        Else P := Nil;

        If ReadFile(FHandle, Buffer, Count, Bytes, P) Then
        Begin
            E := 0;
        End
        Else E := GetLastError;

        If UseOverlapped and (E = ERROR_IO_PENDING) Then
        Begin
            R := WaitForMultipleObjects(2, @EventHandles, False, Timeout);
            If R = WAIT_TIMEOUT Then
            Begin
                If FailTimeout Then Raise EComPort.Create('Read Timeout')
                Else Result := 0;
            End
            Else If (R = WAIT_OBJECT_0) Then
            Begin
                GetOverlappedResult(FHandle, Overlapped, Bytes, False);
                Result := Bytes;
            End;
        End
        Else
        Begin
            If E > 0 Then RaiseLastOSError
            Else Result := Bytes;
        End;
    Finally
        If P <> Nil Then //it is Overlapped
        CloseHandle(Overlapped.hEvent);
    End;
End;

Function TmnOSCommStream.DoWrite(Const Buffer; Count: Integer): Integer;
Var
    Bytes: DWORD;
    Overlapped: TOverlapped;
    EventHandles: Array[0..1] Of THandle;
    P: POverlapped;
    E: Cardinal;
    R: Integer;
Begin
    Bytes := 0;
    Result := 0;
    P := Nil;
    Try
        If UseOverlapped Then
        Begin
            FillChar(Overlapped, SizeOf(Overlapped), 0);
            Overlapped.hEvent := CreateEvent(Nil, True, True, Nil);
            EventHandles[0] := Overlapped.hEvent;
            EventHandles[1] := FCancelEvent;
            P := @Overlapped;
        End
        Else P := Nil;

        If WriteFile(FHandle, Buffer, Count, Bytes, P) Then
        Begin
            E := 0;
        End
        Else E := GetLastError;

        If UseOverlapped and (E = ERROR_IO_PENDING) Then
        Begin
            R := WaitForMultipleObjects(2, @EventHandles, False, Timeout);
            If R = WAIT_TIMEOUT Then
            Begin
                If FailTimeout Then Raise EComPort.Create('Read Timeout')
                Else Result := 0;
            End
            Else If (R = WAIT_OBJECT_0) Then
            Begin
                GetOverlappedResult(FHandle, Overlapped, Bytes, False);
                Result := Bytes;
            End;
        End
        Else
        Begin
            If E > 0 Then RaiseLastOSError
            Else Result := Bytes;
        End;
    Finally
        If P <> Nil Then //it is Overlapped
        CloseHandle(Overlapped.hEvent);
    End;
End;

End.
